home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / hatch.for < prev    next >
Text File  |  1991-05-01  |  11KB  |  285 lines
  1.         SUBROUTINE HATCH(XVERT, YVERT, NUMPTS, PHI, CMSPAC, IFLAGS,
  2.      1   XX, YY)
  3.         IMPLICIT NONE
  4.         REAL*4 XVERT(NUMPTS), YVERT(NUMPTS), XX(NUMPTS), YY(NUMPTS)
  5.         REAL*4 CMSPAC,PHI
  6.         INTEGER NUMPTS,IFLAGS
  7. C
  8. C       ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  9. C
  10. C       H A T C H
  11. C       by Kelly Booth and modified for DIGLIB by Hal Brand
  12. C
  13. C       PROVIDE SHADING FOR A GENERAL POLYGONAL REGION.  THERE IS ABSOLUTELY
  14. C       ASSUMPTION MADE ABOUT CONVEXITY.  A POLYGON IS SPECIFIED BY ITS VERTI
  15. C       GIVEN IN EITHER A CLOCKWISE OR COUNTER-CLOCKWISE ORDER.  THE DENSITY
  16. C       THE SHADING LINES (OR POINTS) AND THE ANGLE FOR THE SHADING LINES ARE
  17. C       BOTH DETERMINED BY THE PARAMETERS PASSED TO THE SUBROUTINE.
  18. C
  19. C       THE INPUT PARAMETERS ARE INTERPRETED AS FOLLOWS:
  20. C
  21. C        XVERT    -  AN ARRAY OF X COORDINATES FOR THE POLYGON(S) VERTICES
  22. C
  23. C        YVERT    -  AN ARRAY OF Y COORDINATES FOR THE POLYGON(S) VERTICES
  24. C
  25. C               NOTE: AN X VALUE >=1E38 SIGNALS A NEW POLYGON.   THIS ALLOWS
  26. C                       FILLING AREAS THAT HAVE HOLES WHERE THE HOLES ARE
  27. C                       DEFINED AS POLYGONS.   IT ALSO ALLOWS MULTIPLE
  28. C                       POLYGONS TO BE FILLED IN ONE CALL TO HATCH.
  29. C
  30. C        NUMPTS  -  THE NUMBER OF VERTICES IN THE POLYGON(S) INCLUDING
  31. C                       THE SEPERATOR(S) IF ANY.
  32. C
  33. C        PHI      -  THE ANGLE FOR THE SHADING, MEASURED COUNTER-CLOCKWISE
  34. C                       IN DEGREES FROM THE POSITIVE X-AXIS
  35. C
  36. C        CMSPAC   -  THE DISTANCE IN VIRTUAL COORDINATES (CM. USUALLY)
  37. C                       BETWEEN SHADING LINES.   THIS VALUE MAY BE ROUNDED
  38. C                       A BIT, SO SOME CUMMULATIVE ERROR MAY BE APPARENT.
  39. C
  40. C        IFLAGS   -  GENERAL FLAGS CONTROLLING HATCH
  41. C                       0 ==>  BOUNDARY NOT DRAWN, INPUT IS VIRTUAL COORD.
  42. C                       1 ==>  BOUNDARY DRAWN, INPUT IS VIRTUAL COORD.
  43. C                       2 ==>  BOUNDARY NOT DRAWN, INPUT IS WORLD COORD.
  44. C                       3 ==>  BOUNDARY DRAWN, INPUT IS WORLD COORD.
  45. C
  46. C        XX       -  A WORK ARRAY ATLEAST "NUMPTS" LONG.
  47. C
  48. C        YY       -  A SECOND WORK ARRAY ATLEAST "NUMPTS" LONG.
  49. C
  50. C     ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  51. C
  52.         INCLUDE DIGLIB$KOM:GCDCHR.PRM
  53. C
  54. C       THIS SUBROUTINE HAS TO MAINTAIN AN INTERNAL ARRAY OF THE TRANSFORMED
  55. C       COORDINATES.  THIS REQUIRES THE PASSING OF THE TWO WORKING ARRAYS
  56. C       CALLED "XX" AND "YY".
  57. C       THIS SUBROUTINE ALSO NEEDS TO STORE THE INTERSECTIONS OF THE HATCH
  58. C       LINES WITH THE POLYGON.   THIS IS DONE IN "XINTCP".
  59. C
  60.         REAL*4 XINTCP(20),BIGNUM,FACT,PI180,COSPHI,SINPHI,YMIN,YMAX
  61.         REAL*4 YSCALE,YSCAL2,XV1,STEP,Y,YHEAD,YTAIL,DELX,DELY,XKEY
  62.         REAL*4 XTEMP,YR,YV1,XV2,YV2
  63.         LOGICAL LMOVE
  64.         INTEGER IDIMX,ITAIL,IHEAD,I,NVERT,ICOUNT,IBASE,IVERT
  65.     INTEGER*1 IAND
  66.         INTEGER J,K
  67.         DATA IDIMX /20/
  68. C
  69. C       X >= 'BIGNUM' SIGNALS THE END OF A POLYGON IN THE INPUT.
  70. C
  71.         DATA BIGNUM /1E38/
  72.         DATA FACT /16.0/
  73.         DATA PI180 /0.017453292/
  74. C
  75. C------------------------------------------------------------------------
  76. C
  77. C       CHECK FOR VALID NUMBER OF VERTICES.
  78. C
  79.         IF (NUMPTS .LT. 3) RETURN
  80. C
  81. C       CONVERT ALL OF THE POINTS TO INTEGER COORDINATES SO THAT THE SHADING
  82. C       LINES ARE HORIZONTAL.  THIS REQUIRES A ROTATION FOR THE GENERAL CASE.
  83. C       THE TRANSFORMATION FROM VIRTUAL TO INTERNAL COORDINATES HAS THE TWO
  84. C       OR THREE PHASES:
  85. C
  86. C       (1)  CONVERT WORLD TO VIRTUAL COORD. IF INPUT IN WORLD COORD.
  87. C
  88. C       (2)  ROTATE CLOCKWISE THROUGH THE ANGLE PHI SO SHADING IS HORIZONTAL,
  89. C
  90. C       (3)  SCALE TO INTEGERS IN THE RANGE
  91. C               [0...2*FACT*(DEVICE_MAXY_COORDINATE)], FORCING COORDINATES
  92. C               TO BE ODD INTEGERS.
  93. C
  94. C       THE COORDINATES ARE ALL ODD SO THAT LATER TESTS WILL NEVER HAVE AN
  95. C       OUTCOME OF "EQUAL" SINCE ALL SHADING LINES HAVE EVEN COORDINATES.
  96. C       THIS GREATLY SIMPLIFIES SOME OF THE LOGIC.
  97. C
  98. C       AT THE SAME TIME THE PRE-PROCESSING IS BEING DONE, THE INPUT IS CHECK
  99. C       FOR MULTIPLE POLYGONS.  IF THE X-COORDINATE OF A VERTEX IS >= 'BIGNUM
  100. C       THEN THE POINT IS NOT A VERTEX, BUT RATHER IT SIGNIFIES THE END OF A
  101. C       PARTICULAR POLYGON.  AN IMPLIED EDGE EXISTS BETWEEN THE FIRST AND LAS
  102. C       VERTICES IN EACH POLYGON.  A POLYGON MUST HAVE AT LEAST THREE VERTICE
  103. C       ILLEGAL POLYGONS ARE REMOVED FROM THE INTERNAL LISTS.
  104. C
  105. C
  106. C       COMPUTE TRIGONOMETRIC FUNCTIONS FOR THE ANGLE OF ROTATION.
  107. C
  108.         COSPHI = COS(PI180*PHI)
  109.         SINPHI = SIN(PI180*PHI)
  110. C
  111. C       FIRST CONVERT FROM WORLD TO VIRTUAL COORD. IF NECESSARY AND ELIMINATE
  112. C       ANY POLYGONS WITH TWO OR FEWER VERTICES
  113. C
  114.         ITAIL = 1
  115.         IHEAD = 0
  116.         DO 120 I = 1, NUMPTS
  117. C
  118. C               ALLOCATE ANOTHER POINT IN THE VERTEX LIST.
  119. C
  120.                 IHEAD = IHEAD + 1
  121. C
  122. C               A XVERT >= 'BIGNUM' IS A SPECIAL FLAG.
  123. C
  124.                 IF (XVERT(I) .LT. BIGNUM) GO TO 110
  125.                  XX(IHEAD) = BIGNUM
  126.                  IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1
  127.                  ITAIL = IHEAD + 1
  128.                  GO TO 120
  129. 110             CONTINUE
  130. C
  131. C               CONVERT FROM WORLD TO VIRTUAL COORD. IF INPUT IS WORLD COORD.
  132. C
  133.                 IF (IAND(IFLAGS,2) .EQ. 0) GO TO 115
  134.                    CALL SCALE(XVERT(I),YVERT(I),XX(IHEAD),YY(IHEAD))
  135.                    GO TO 120
  136. 115                CONTINUE
  137.                         XX(IHEAD) = XVERT(I)
  138.                         YY(IHEAD) = YVERT(I)
  139. 120             CONTINUE
  140.         IF ((IHEAD-ITAIL) .LT. 2) IHEAD = ITAIL - 1
  141.         NVERT = IHEAD
  142. C
  143. C       DRAW BOUNDARY(S) IF DESIRED
  144. C
  145.         IF (IAND(IFLAGS,1) .EQ. 0) GO TO 138
  146.         IHEAD = 0
  147.         ITAIL = 1
  148.         LMOVE = .TRUE.
  149. 130             CONTINUE
  150.                 IHEAD = IHEAD + 1
  151.                 IF (IHEAD .GT. NVERT) GO TO 133
  152.                 IF (XX(IHEAD) .NE. BIGNUM) GO TO 135
  153. 133              CONTINUE
  154.                  CALL GSDRAW(XX(ITAIL),YY(ITAIL))
  155.                  ITAIL = IHEAD + 1
  156.                  LMOVE = .TRUE.
  157.                  GO TO 139
  158. 135             CONTINUE
  159.                 IF (LMOVE) GO TO 137
  160.                  CALL GSDRAW(XX(IHEAD),YY(IHEAD))
  161.                  GO TO 139
  162. 137             CONTINUE
  163.                 CALL GSMOVE(XX(IHEAD),YY(IHEAD))
  164.                 LMOVE = .FALSE.
  165. 139             CONTINUE
  166.                 IF (IHEAD .LE. NVERT) GO TO 130
  167. 138     CONTINUE
  168. C
  169. C       ROTATE TO MAKE SHADING LINES HORIZONTAL
  170. C
  171.         YMIN = BIGNUM
  172.         YMAX = -BIGNUM
  173.         YSCALE = YRES*FACT
  174.         YSCAL2 = 2.0*YSCALE
  175.         DO 140 I = 1, NVERT
  176.                 IF (XX(I) .EQ. BIGNUM) GO TO 140
  177. C
  178. C               PERFORM THE ROTATION TO ACHIEVE HORIZONTAL SHADING LINES.
  179. C
  180.                 XV1 = XX(I)
  181.                 XX(I) = +COSPHI*XV1 + SINPHI*YY(I)
  182.                 YY(I) = -SINPHI*XV1 + COSPHI*YY(I)
  183. C
  184. C               CONVERT TO INTEGERS AFTER SCALING, AND MAKE VERTICES ODD. IN
  185. C
  186.                 YY(I) = 2.0*AINT(YSCALE*YY(I)+0.5)+1.0
  187.                 YMIN = AMIN1(YMIN,YY(I))
  188.                 YMAX = AMAX1(YMAX,YY(I))
  189. 140             CONTINUE
  190. C
  191. C       MAKE SHADING START ON A MULTIPLE OF THE STEP SIZE.
  192. C
  193.         STEP = 2.0*AINT(YRES*CMSPAC*FACT)
  194.         YMIN = AINT(YMIN/STEP) * STEP
  195.         YMAX = AINT(YMAX/STEP) * STEP
  196. C
  197. C       AFTER ALL OF THE COORDINATES FOR THE VERTICES HAVE BEEN PRE-PROCESSED
  198. C       THE APPROPRIATE SHADING LINES ARE DRAWN.  THESE ARE INTERSECTED WITH
  199. C       THE EDGES OF THE POLYGON AND THE VISIBLE PORTIONS ARE DRAWN.
  200. C
  201.         Y = YMIN
  202. 150             CONTINUE
  203.                 IF (Y .GT. YMAX) GO TO 250
  204. C
  205. C               INITIALLY THERE ARE NO KNOWN INTERSECTIONS.
  206. C
  207.                 ICOUNT = 0
  208.                 IBASE = 1
  209.                 IVERT = 1
  210. 160                     CONTINUE
  211.                         ITAIL = IVERT
  212.                         IVERT = IVERT + 1
  213.                         IHEAD = IVERT
  214.                         IF (IHEAD .GT. NVERT) GO TO 165
  215.                         IF (XX(IHEAD) .NE. BIGNUM) GO TO 170
  216. C
  217. C                         THERE IS AN EDGE FROM VERTEX N TO VERTEX 1.
  218. C
  219. 165                       IHEAD = IBASE
  220.                           IBASE = IVERT + 1
  221.                           IVERT = IVERT + 1
  222. 170                     CONTINUE
  223. C
  224. C                       SEE IF THE TWO ENDPOINTS LIE ON
  225. C                       OPPOSITE SIDES OF THE SHADING LINE.
  226. C
  227.                         YHEAD =  Y - YY(IHEAD)
  228.                         YTAIL =  Y - YY(ITAIL)
  229.                         IF (YHEAD*YTAIL .GE. 0.0) GO TO 180
  230. C
  231. C                       THEY DO.  THIS IS AN INTERSECTION.  COMPUTE X.
  232. C
  233.                         ICOUNT = ICOUNT + 1
  234.                         DELX = XX(IHEAD) - XX(ITAIL)
  235.                         DELY = YY(IHEAD) - YY(ITAIL)
  236.                         XINTCP(ICOUNT) = (DELX/DELY) * YHEAD + XX(IHEAD)
  237. 180                     CONTINUE
  238.                         IF ( IVERT .LE. NVERT ) GO TO 160
  239. C
  240. C               SORT THE X INTERCEPT VALUES.  USE A BUBBLESORT BECAUSE THERE
  241. C               AREN'T VERY MANY OF THEM (USUALLY ONLY TWO).
  242. C
  243.                 IF (ICOUNT .EQ. 0) GO TO 240
  244.                 DO 200 I = 2, ICOUNT
  245.                         XKEY = XINTCP(I)
  246.                         K = I - 1
  247.                         DO 190 J = 1, K
  248.                            IF (XINTCP(J) .LE. XKEY) GO TO 190
  249.                            XTEMP = XKEY
  250.                            XKEY = XINTCP(J)
  251.                            XINTCP(J) = XTEMP
  252. 190                        CONTINUE
  253.                         XINTCP(I) = XKEY
  254. 200                     CONTINUE
  255. C
  256. C               ALL OF THE X COORDINATES FOR THE SHADING SEGMENTS ALONG THE
  257. C               CURRENT SHADING LINE ARE NOW KNOWN AND ARE IN SORTED ORDER.
  258. C               ALL THAT REMAINS IS TO DRAW THEM.  PROCESS THE X COORDINATES
  259. C               TWO AT A TIME.
  260. C
  261.                 YR = Y/YSCAL2
  262.                 DO 230 I = 1, ICOUNT, 2
  263. C
  264. C                       CONVERT BACK TO VIRTUAL COORDINATES.
  265. C                       ROTATE THROUGH AN ANGLE OF -PHI TO ORIGINAL ORIENTATI
  266. C                       THEN UNSCALE FROM GRID TO VIRTUAL COORD.
  267. C
  268.                         XV1 = + COSPHI*XINTCP(I) - SINPHI*YR
  269.                         YV1 = + SINPHI*XINTCP(I) + COSPHI*YR
  270.                         XV2 = + COSPHI*XINTCP(I+1) - SINPHI*YR
  271.                         YV2 = + SINPHI*XINTCP(I+1) + COSPHI*YR
  272. C                       TYPE *,'LINE: (',XV1,YV1,') TO (',XV2,YV2,')'
  273. C
  274. C                       DRAW THE SEGMENT OF THE SHADING LINE.
  275. C
  276.                         CALL GSMOVE(XV1,YV1)
  277.                         CALL GSDRAW(XV2,YV2)
  278. 230                     CONTINUE
  279. 240             CONTINUE
  280.                 Y = Y + STEP
  281.                 GO TO 150
  282. 250     CONTINUE
  283.         RETURN
  284.         END
  285.